home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / mlibv22.zip / VIEWSHP.BAS < prev   
BASIC Source File  |  1993-01-27  |  8KB  |  148 lines
  1. DEFINT A-Z
  2. '******************************* VIEWSHP.BAS ********************************
  3. '*                                                                          *
  4. '* This example will: Load all the shape data from [DEMO.SHP] file using    *
  5. '*                  : the random access method.                             *
  6. '*                  :                                                       *
  7. '*                  : Display each shape when mouse button is pressed.      *
  8. '*                                                                          *
  9. '* NOTE: In order for this demo to run you must start the QB editor         *
  10. '*     : along with the library MLIBN.QLB  (ie., QB/L MLIBN).               *
  11. '*     :                                                                    *
  12. '*     : IF YOU ARE NOT USING QuickBASIC 4.0- 4.5 SEE PAGE 2 OF THE MANUAL  *
  13. '*     : BEFORE TRYING TO RUN THIS DEMO!                                    *
  14. '*     :                                                                    *
  15. '*     : The first record (or 80 bytes) of each shape file is the header;   *
  16. '*     : it is of importance only to the mouse editor.                      *
  17. '*     :                                                                    *
  18. '*                                                                          *
  19. '****************************************************************************
  20.  
  21. '$INCLUDE: 'mlib.inc'
  22.  
  23. DECLARE SUB Target ()
  24. DECLARE SUB MHold (B%)
  25. DECLARE SUB LoadShape (SHPRec() AS MOUSEtype, OpenSHP$)
  26.  
  27. '============================================================================
  28. SCREEN 12: CLS : CALL InitPointer(NumBut%)       'Initialize mouse.
  29. IF NumBut% = 0 THEN SCREEN 0: END                'No mouse.
  30.                                                  '
  31. CALL GetSpeedM(H1%, V1%, D1%)                    'Get movement sensitivity.
  32. CALL SetSpeedM(50, 50, 100)                      'Set new state.
  33.                                                  '
  34. REDIM SHPRec(0) AS MOUSEtype                     'Shape data array.
  35.                                                  '
  36. CALL LoadShape(SHPRec(), "DEMO.SHP")             'Open and load shape data.
  37.                                                  '
  38. CALL Target                                      '
  39.                                                  '
  40. PRINT "  <Press a key to end.> ";                '
  41. PRINT "<Mouse button = next shape>": ShowPointer '
  42.                                                  '
  43. ElNum% = 1                                       '
  44.                                                  '
  45. DO                                               '
  46.                                                  '
  47.    CALL GetButtonM(BUT%, X%, Y%)                 'Check for button press.
  48.                                                  '
  49.    IF BUT% THEN                                  '
  50.                                                  '
  51.       IF ElNum% < UBOUND(SHPRec, 1) THEN         'Last record.
  52.          ElNum% = ElNum% + 1                     '
  53.       ELSE                                       '
  54.          ElNum% = LBOUND(SHPRec, 1)              'First shape(second record).
  55.       END IF                                     '
  56.                                                  '
  57.       CALL HidePointer                           '
  58.                                                  '
  59.       LOCATE 1, 58: PRINT "Record:"; ElNum% - 1; '
  60.       PRINT SHPRec(ElNum%).FRM                   'Format (Trans or solid).
  61.                                                  '
  62.       CALL ShowPointer                           '
  63.                                                  '
  64.       SHPSTR$ = SHPRec(ElNum%).DAT               'Shape data.
  65.       HSX% = SHPRec(ElNum%).HTX                  'Hot X.
  66.       HSY% = SHPRec(ElNum%).HTY                  'Hot Y.
  67.                                                  '
  68.       CALL ChangePointer(SHPSTR$, HSX%, HSY%)    'Change shape of pointer.
  69.                                                  '
  70.       CALL MHold(BUT%)                           '
  71.                                                  '
  72.    END IF                                        '
  73.                                                  '
  74. LOOP WHILE INKEY$ = ""                           '
  75.                                                  '
  76. CALL SetSpeedM(H1%, V1%, D1%)                    'Restore sensitivity state.
  77.                                                  '
  78. SCREEN 0: END                                    '
  79.                                                  '
  80. '=============================================================================
  81.  
  82. '
  83. '****************************************************************************
  84. '*                                                                          *
  85. '*           --------------------------------------------------------       *
  86. '*           NOTE! THE FIRST RECORD IN EACH "SHP" FILE IS THE HEADER.       *
  87. '*           --------------------------------------------------------       *
  88. '*                                                                          *
  89. '* SHPRec() AS MOUSEtype     : The array that holds the shape data.         *
  90. '*             OpenSHP$      : The shape file that will be opened.          *
  91. '*                           :                                              *
  92. '* TYPE MOUSEtype            : Each record is 80 bytes.                     *
  93. '*      DLT    AS INTEGER    : 2  bytes for editor use.                     *
  94. '*      HTX    AS INTEGER    : 2  bytes for hotspot  X.                     *
  95. '*      HTY    AS INTEGER    : 2  bytes for hotspot  Y.                     *
  96. '*      MODE   AS STRING     : 10 bytes for solid or transparent ID.        *
  97. '*      SHPSTR AS STRING     : 64 bytes for shape data.                     *
  98. '* END TYPE                                                                 *
  99. '*                                                                          *
  100. '****************************************************************************
  101.                                                  '
  102. SUB LoadShape (SHPRec() AS MOUSEtype, OpenSHP$)  '
  103.                                                  '
  104. RecLen% = LEN(SHPRec(LBOUND(SHPRec, 1)))         'Length of a record.
  105.                                                  '
  106. FH% = FREEFILE                                   '
  107.                                                  '
  108. OPEN OpenSHP$ FOR RANDOM AS #FH% LEN = RecLen%   '
  109.                                                  '
  110. RecMax% = (LOF(FH%) \ RecLen%)                   'Calculate number of records.
  111.                                                  'Skip header(start at 2).
  112. REDIM SHPRec(2 TO RecMax%) AS MOUSEtype          'Dimension buffer to hold
  113.                                                  'all the shapes from disk.
  114. FOR Num% = 2 TO RecMax%                          'Load all the different
  115.                                                  'pointer shape data strings
  116.    GET #FH%, Num%, SHPRec(Num%)                  'plus hot spots off disk.
  117.                                                  '
  118. NEXT Num%                                        '
  119.                                                  '
  120. CLOSE #FH%                                       '
  121.                                                  '
  122. END SUB                                          '
  123.  
  124. SUB MHold (B%) STATIC'Loop while a mouse button is being held down.
  125.  
  126. DO: CALL GetButtonM(B%, X%, Y%)
  127.  
  128. LOOP WHILE B%
  129.  
  130. END SUB
  131.  
  132. SUB Target 'Draw a background.
  133.  
  134. LINE (15, 16)-(615, 465), 15, BF
  135.  
  136. Colr% = 0
  137.  
  138. FOR Size% = 220 TO 20 STEP -20
  139.   
  140.    Colr% = Colr% + 1
  141.    CIRCLE (320, 240), Size%, Colr%
  142.    PAINT (320, 240), Colr%, Colr%
  143.  
  144. NEXT
  145.  
  146. END SUB
  147.  
  148.